Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/newrouts/newrouts.frm

Visual Basic Form | 1997-06-13 | 16KB | 498 lines

VERSION 4.00
Begin VB.Form frmNewRouts
   Caption         =   "Add a new Routine"
   ClientHeight    =   3285
   ClientLeft      =   3540
   ClientTop       =   1905
   ClientWidth     =   4935
   Height          =   3975
   Icon            =   "NewRouts.frx":0000
   Left            =   3480
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   3285
   ScaleWidth      =   4935
   Top             =   1275
   Width           =   5055
   Begin VB.Frame Frame1
      Height          =   420
      Left            =   30
      TabIndex        =   15
      Top             =   0
      Width           =   4875
      Begin VB.OptionButton optSub
         Caption         =   "&Sub Procedure"
         Height          =   225
         Left            =   90
         TabIndex        =   17
         Top             =   135
         Value           =   -1  'True
         Width           =   2055
      End
      Begin VB.OptionButton optFunction
         Caption         =   "F&unction"
         Height          =   195
         Left            =   3135
         TabIndex        =   16
         Top             =   150
         Width           =   1455
      End
   End
   Begin VB.TextBox txtMaxLen
      BeginProperty Font
         name            =   "Fixedsys"
         charset         =   0
         weight          =   400
         size            =   9
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   105
      TabIndex        =   8
      Top             =   2925
      Visible         =   0   'False
      Width           =   495
   End
   Begin VB.TextBox txtSinNum
      BeginProperty Font
         name            =   "Fixedsys"
         charset         =   0
         weight          =   400
         size            =   9
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   3465
      TabIndex        =   4
      Top             =   2430
      Width           =   1305
   End
   Begin VB.TextBox txtProgName
      BeginProperty Font
         name            =   "Fixedsys"
         charset         =   0
         weight          =   400
         size            =   9
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   1110
      TabIndex        =   1
      Top             =   885
      Width           =   3645
   End
   Begin VB.ComboBox cboRetType
      BeginProperty Font
         name            =   "Fixedsys"
         charset         =   0
         weight          =   400
         size            =   9
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   345
      ItemData        =   "NewRouts.frx":0442
      Left            =   1110
      List            =   "NewRouts.frx":0467
      TabIndex        =   3
      Top             =   2430
      Width           =   1275
   End
   Begin VB.CommandButton cmdAddVariable
      Caption         =   "Add &Parameters ..."
      Height          =   345
      Left            =   3360
      TabIndex        =   5
      Top             =   2820
      Width           =   1470
   End
   Begin VB.CommandButton cmdAbort
      Caption         =   "&Abort Build"
      Height          =   345
      Left            =   2280
      TabIndex        =   7
      Top             =   2835
      Width           =   1020
   End
   Begin VB.CommandButton cmdBuild
      Caption         =   "&Build Routine"
      Height          =   330
      Left            =   1110
      TabIndex        =   6
      Top             =   2850
      Width           =   1125
   End
   Begin VB.TextBox txtDesc
      BeginProperty Font
         name            =   "Fixedsys"
         charset         =   0
         weight          =   400
         size            =   9
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   1065
      Left            =   1110
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   1305
      Width           =   3645
   End
   Begin VB.TextBox txtAuthor
      BeginProperty Font
         name            =   "Fixedsys"
         charset         =   0
         weight          =   400
         size            =   9
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   1110
      TabIndex        =   0
      Top             =   510
      Width           =   3645
   End
   Begin VB.Label Label6
      Caption         =   "Sin# (if any) :"
      Height          =   285
      Left            =   2565
      TabIndex        =   14
      Top             =   2445
      Width           =   885
   End
   Begin VB.Label Label5
      Caption         =   "Function"
      Height          =   225
      Left            =   75
      TabIndex        =   13
      Top             =   2250
      Width           =   855
   End
   Begin VB.Label Label4
      Caption         =   "Routine Name:"
      Height          =   390
      Left            =   45
      TabIndex        =   12
      Top             =   885
      Width           =   975
   End
   Begin VB.Label Label3
      Caption         =   "Return Type :"
      Height          =   300
      Left            =   75
      TabIndex        =   11
      Top             =   2445
      Width           =   1065
   End
   Begin VB.Label Label2
      Caption         =   "Description :"
      Height          =   345
      Left            =   75
      TabIndex        =   10
      Top             =   1305
      Width           =   990
   End
   Begin VB.Label Label1
      Caption         =   "Author :"
      Height          =   255
      Left            =   60
      TabIndex        =   9
      Top             =   480
      Width           =   1050
   End
   Begin VB.Menu mnFile
      Caption         =   "&File"
      Begin VB.Menu mnExit
         Caption         =   "&Exit"
      End
   End
   Begin VB.Menu mnHelp
      Caption         =   "&Help"
      Begin VB.Menu mnAbout
         Caption         =   "&About"
      End
   End
Attribute VB_Name = "frmNewRouts"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim retcode&
Private Sub cmdAbort_Click()
    ResetScr
    Unload Me
End Sub
Private Sub cmdAddVariable_Click()
    Dim ub%, i%
    On Error GoTo Loadfrm
    ub% = UBound(gParms())
    On Error GoTo 0
    For i = 0 To ub%
        frmAddVariables.lstVars.AddItem gParms(i)
    Next i
Loadfrm:
    frmAddVariables.Show vbModal
End Sub
Sub BuildRoutine()
    '**************************************
    '* Author : Michael J. Cox
    '* Date : 6/13/97
    '* Email : [e-mail]
    '*
    '* Desc:
    '*   This routine does all the work.
    '*   It builds a temporary ascii file and
    '*   then load it into the active form.
    '*
    '*   Modify this routine to customize the
    '*   new routine template.
    '***********************************
    On Error GoTo BuildRoutineErr
    Dim CurForm As Object, maxlen%
    Dim i%, nFileHnd%, dSub$, dDate$, oldtext$
    Dim dArgs$, dParmsDesc$(), dParms$()
    Dim dTab$, tParms%, dRetType$
    dDate = Date
    dTab$ = Space(4)
    maxlen% = gMaxLen%
    Set CurForm = gobjVBInst.ActiveProject.ActiveForm
    On Error GoTo noParms
    tParms% = UBound(gParms()) + 1
noParms:
    On Error GoTo BuildRoutineErr
    nFileHnd = FreeFile
    Open App.Path & "\Routine.txt" For Output As nFileHnd
    If gIsFunction And (cboRetType.Text) <> "" Then
        dSub$ = "Function "
        dRetType$ = " As " & Trim(cboRetType.Text)
    Else
        dSub$ = "Sub "
        dRetType$ = ""
    End If